# Usage: advance.tcl game.txt

package require Iexpect

namespace eval Advance {
	proc mention {msg {lineNr {}} {info {}}} {
		global errMsg
		if {[string length $lineNr]} {
			puts [set errMsg "Error on line $lineNr: $msg"]
		} else {
			puts [set errMsg "Error: $msg"]
		}
		if {[llength $info]} {
			puts [join $info "\n"]
		}
		return 0
	}
	
	proc fileCheck {fileName fileExt hasToExist} {
		if {![string equal -nocase ".$fileExt" [file extension $fileName]]} {
			mention "Expected file extension $fileExt for file: $fileName"
			return 0
		}
		if {$hasToExist && ![file exists $fileName]} {
			mention "File does not exist: $fileName"
			return 0
		}
		return 1
	}
	
	proc record {line {move 0}} {
		variable inBuffer; variable frontBuffer; variable backBuffer; variable endBuffer
				
		set line "$line\n"
		switch $move 1 {
			append backBuffer $line
		} 2 {
			append frontBuffer $inBuffer
			set inBuffer ""
			append frontBuffer $backBuffer
			set backBuffer ""
			append frontBuffer $line
		} 3 {
			set endBuffer $backBuffer
			set backBuffer ""
			append endBuffer $line
		} 4 {
			set endBuffer $backBuffer
			set backBuffer ""
			append endBuffer $line
			append inBuffer $endBuffer
		} default {
			append inBuffer $backBuffer
			set backBuffer ""
			append inBuffer $line
		}
	}
	
	proc incrSeason {} {
		variable phase; variable year; variable season; variable seasons; variable hasRetreats
		switch $phase 0 {
			return "AfterGameStart"
		} 1 {
			return "$year $season"
		} 2 {
			set idx [expr [lsearch $seasons $season] + 1]
			if {$idx == [llength $seasons]} {
				incr year
				set season [lindex $seasons 0]
			} else {
				set season [lindex $seasons $idx]
			}
			return "$year $season"
		} 3 {
			if $hasRetreats {
				return "$year After${season}Retreat"
			} else {
				return "$year After$season"
			}
		}
	}
	
	proc advance {gameRecordFile} {
		variable inBuffer; variable frontBuffer; variable backBuffer; variable endBuffer
		variable phase; variable year; variable season; variable seasons; variable hasRetreats
								
		if {![fileCheck $gameRecordFile txt 1]} return
		
		# Read everything into a inBuffer and look for the last season.
		iexpect::Expect I -file $gameRecordFile -white -case
		
		set seasons {Spring Fall Winter}
		set showSeasons $seasons
		set hasRetreats 0
		
		set title ""
		set nrOfSeasons 0
		set inBuffer ""
		set frontBuffer ""
		set backBuffer ""
		set phase 0
		set year 1901
		set season Spring
		set neutrals {}
		
		set reYear "-?\\d+"
		set reSeason [join $seasons "|"]
		
		I expect line "^%# GameStart: ($reYear) ($reSeason)$" {
			record [I get output] 1
			set year [I get match 1]
			set season [I get match 2]
			I continue	
		} "^%# GameEnd: ($reYear) ($reSeason)$" {
			record [I get output] 1
			set endYear [I get match 1]
			set endSeason [I get match 2]
			I continue
		} "^%# Seasons: (${reSeason}( $reSeason)+)$" {
			record [I get output] 1
			set showSeasons [I get match 1]
			I continue
		} "^$" {
			record "" 1
			I continue
		} "^%" {
			record [I get output] 1
			I continue
		} "^ShowPage$" {
			record [I get output] 4
			I continue
		} "^End$" {
			record [I get output] 3
		} "^(\[(\](.*)\[)\] )?GameStart$" {
			if $nrOfSeasons {
				mention "GameStart should be the first season." [I get line_nr]
			} else {
				incr nrOfSeasons
				set title [I get match 1]
				record [I get output] 2
				set phase 0
				I continue
			}
		} "^(\[(\].*\[)\] )?AfterGameStart$" {
			if {$nrOfSeasons > 1} {
				mention "AfterGameStart should be the second season." [I get line_nr]
			} else {
				set title [I get match 1]
				incr nrOfSeasons
				set phase 1
				record "$title[incrSeason]" 2
				set phase 3
				I continue
			}
		} "^(\[(\].*\[)\] )?($reYear) ($reSeason)$" {
			if {$phase > 2} {
				mention "No extra seasons allowed after the final season." [I get line_nr]
			} else {
				incr nrOfSeasons
				set title [I get match 1]
				set year [I get match 2]
				set season [I get match 3]
				record [I get output] 2
				set phase 2
				if [info exists endSeason] {
					if {($endYear < $year) || 
						(($endYear == $year) && ([lsearch $seasons $endSeason] <= [lsearch $seasons $season]))} {
						set phase 3
					}
				}
				I continue
			}
		} "^(\[(\].*\[)\] )?(-?\\d+) After($reSeason)(Retreat)?$" {
			if {$phase > 2} {
				mention "Can't advance past the final season." [I get line_nr]
			} else {
				incr nrOfSeasons
				set title [I get match 1]
				set year [I get match 2]
				set season [I get match 3]
				set phase 2
				record "$title[incrSeason]" 2
				set phase 3
				I continue
			}
		} "^(\[(\].*\[)\] )?(($reYear )?(\[A-Z\]\[a-z\]+)+)$" {
			mention "Unrecognized season \"[I get match 3]\"." [I get line_nr]
		} default {
			record [I get output]
			I continue
		}
		#"^(\[(\].*\[)\] )?(-?\\d+) After(Spring|Fall|Winter)(Retreat)?$" {
		#	if {$phase < 1} {
		#		mention "No after season allowed at game start." [I get line_nr]
		#	} elseif {$phase > 1} {
		#		mention "No extra seasons allowed after an after season." [I get line_nr]
		#	} elseif {$year <> [I get match 2]} {
		#		mention "After season year doesn't match that of previous season." [I get line_nr]
		#	} elseif {$season <> [I get match 4]} {
		#		mention "After season doesn't match previous season." [I get line_nr]
		#	} else {
		#		set inBuffer ""
		#		set title [I get match 1]
		#		set phase [expr [string length [I get match 5]] 3 : 2]
		#		I continue
		#	}
		#}
		
		itcl::delete object I
		
		if [info exists errMsg] {
			puts "Quitting."
			return
		}
		
		if {$nrOfSeasons == 0} {
			mention "No full seasons encountered."
			puts "Quitting."
			return
		}
		
		iexpect::Expect I -string $inBuffer -white -nocase

		variable country; variable units; variable provinces
		
		set powers {}
		array set centers ""
		array set values ""
		array set units ""
		array set provinces ""
		set country ""
		
		set reProvince "\[^ \]+"
		set reUnit "\[af\]"
		set reRetreat "r (.*)(\[!?*\])"
				
		proc retreat {unit destinations result} {
			variable country; variable units; variable provinces; variable hasRetreats
			set hasRetreats 1
			switch $result "!" {
				lappend units($country) $unit
				lappend provinces($country) [lindex $destinations 0]
			}
		}
		
		I expect line "^$" {
			I continue
		} "^%" {
			I continue
		} "^($reProvince) (\[$^`\])$" {
			lappend centers($country) [string toupper [I get match 1]] 
			lappend values($country) [I get match 2]
			I continue
		} "^($reUnit) ($reProvince) (\[!?+*\])$" {
			set idx 0
			set unit [string toupper [I get match [incr idx]]]
			set province [string toupper [I get match [incr idx]]]
			set operator [I get match [incr idx]]
			switch $operator "!" {
				lappend units($country) $unit
				lappend provinces($country) $province
			} "+" {
				lappend units($country) $unit
				lappend provinces($country) $province
			}
			I continue
		} "^($reUnit) ($reProvince) h (\[!~*\]|($reRetreat))$" {
			set idx 0
			set unit [string toupper [I get match [incr idx]]]
			set province [string toupper [I get match [incr idx]]]
			set operator [I get match [incr idx]]
			if [string length [I get match [incr idx]]] {
				retreat $unit [string toupper [I get match [incr idx]]] [I get match [incr idx]]
			} else {
				switch $operator "!" {
					lappend units($country) $unit
					lappend provinces($country) $province
				} 
			}
			I continue
		} "^($reUnit) ($reProvince) s ($reProvince) (\[!?|~*\]|($reRetreat))$" {
			set idx 0
			set unit [string toupper [I get match [incr idx]]]
			set province [string toupper [I get match [incr idx]]]
			set origin [string toupper [I get match [incr idx]]]
			set operator [I get match [incr idx]]
			if [string length [I get match [incr idx]]] {
				retreat $unit [string toupper [I get match [incr idx]]] [I get match [incr idx]]
			} else {
				switch $operator "!" {
					lappend units($country) $unit
					lappend provinces($country) $province
				} "?" {
					lappend units($country) $unit
					lappend provinces($country) $province
				} "|" {
					lappend units($country) $unit
					lappend provinces($country) $province
				} 
			}
			I continue
		} "^($reUnit) ($reProvince) s ($reProvince) ($reProvince) (\[!?|~*\]|($reRetreat))$" {
			set idx 0
			set unit [string toupper [I get match [incr idx]]]
			set province [string toupper [I get match [incr idx]]]
			set origin [string toupper [I get match [incr idx]]]
			set destination [string toupper [I get match [incr idx]]]
			set operator [I get match [incr idx]]
			if [string length [I get match [incr idx]]] {
				retreat $unit [string toupper [I get match [incr idx]]] [I get match [incr idx]]
			} else {
				switch $operator "!" {
					lappend units($country) $unit
					lappend provinces($country) $province
				} "?" {
					lappend units($country) $unit
					lappend provinces($country) $province
				} "|" {
					lappend units($country) $unit
					lappend provinces($country) $province
				} 
			}
			I continue
		} "^($reUnit) ($reProvince) c ($reProvince) ($reProvince) (\[!?~*\]|($reRetreat))$" {
			set idx 0
			set unit [string toupper [I get match [incr idx]]]
			set province [string toupper [I get match [incr idx]]]
			set origin [string toupper [I get match [incr idx]]]
			set destination [string toupper [I get match [incr idx]]]
			set operator [I get match [incr idx]]
			if [string length [I get match [incr idx]]] {
				retreat $unit [string toupper [I get match [incr idx]]] [I get match [incr idx]]
			} else {
				switch $operator "!" {
					lappend units($country) $unit
					lappend provinces($country) $province
				} "?" {
					lappend units($country) $unit
					lappend provinces($country) $province
				} 
			}
			I continue
		} "^($reUnit) ($reProvince) $reRetreat$" {
			set idx 0
			set unit [string toupper [I get match [incr idx]]]
			set province [string toupper [I get match [incr idx]]]
			set destinations [string toupper [I get match [incr idx]]]
			set operator [I get match [incr idx]]
			retreat $unit $destinations $operator
			I continue
		} "^($reUnit) ($reProvince) ($reProvince) (\[!?|~*\]|($reRetreat))$" {
			set idx 0
			set unit [string toupper [I get match [incr idx]]]
			set province [string toupper [I get match [incr idx]]]
			set destination [string toupper [I get match [incr idx]]]
			set operator [I get match [incr idx]]
			if [string length [I get match [incr idx]]] {
				retreat $unit [string toupper [I get match [incr idx]]] [I get match [incr idx]]
			} else {
				switch $operator "!" {
					lappend units($country) $unit
					lappend provinces($country) $destination
				} "?" {
					lappend units($country) $unit
					lappend provinces($country) $province
				} "|" {
					lappend units($country) $unit
					lappend provinces($country) $province
				} 
			}
			I continue
		} -case "^ShowPage$" {
			I continue
		} "^$reProvince$" {
			set country [string toupper [I get match]]
			if {[lsearch $powers $country] == -1} {
				lappend powers $country
				set centers($country) {}
				set values($country) {}
				set units($country) {}
				set provinces($country) {}
			}
			I continue
		} default {
			mention "Unrecognized line \"[I get output]\"." [I get line_nr]
			I continue
		}
		
		itcl::delete object I
		
		if [info exists errMsg] {
			puts "Quitting."
			return
		}
		
		switch $season Fall {
			# Change ownership
			foreach country $powers {
				foreach province $provinces($country) {
					set territory [lindex [split $province "/"] 0]
					set isSupply 0
					if {[set idx [lsearch $centers($country) $territory]] >= 0} {
						set isSupply 2
						switch [lindex $values($country) $idx] "`" {
							set values($country) [lreplace $values($country) $idx $idx "^"]
						} default {
							continue
						}
					}
					foreach power $powers {
						if [string equal $power $country] continue
						if {[set idx [lsearch $centers($power) $territory]] >= 0} {
							if {!$isSupply} {
								set isSupply 1
							}
							switch [lindex $values($power) $idx] "$" {
								set centers($power) [lreplace $centers($power) $idx $idx]
								set values($power) [lreplace $values($power) $idx $idx]
								break
							} "^" {
								set values($power) [lreplace $values($power) $idx $idx "`"]
								break
							}
						}
					}
					if {$isSupply == 1} {
						lappend centers($country) $territory
						lappend values($country) "$"
					}
				}
			}
		}
		
		set g [open $gameRecordFile "w"]
		puts -nonewline $g $frontBuffer
		puts -nonewline $g $inBuffer
		
		puts $g "\n% Season"
		puts $g "\n$title[incrSeason]"
		
		puts $g "\n% Centers"
		foreach power $powers {
			if [llength $centers($power)] {
				puts $g "\n$power\n"
				foreach center $centers($power) value $values($power) {
					puts $g "$center $value"
				}
			} elseif {[llength $provinces($power)]} {
				puts $g "\n$power"
			}
		}
		
		puts $g "\n% Orders"
		foreach power $powers {
			if [llength $units($power)] {
				puts $g "\n$power\n"
				foreach unit $units($power) province $provinces($power) {
					puts $g "$unit $province !"
				}
			} elseif {[string equal $season Fall] && ([lsearch $values($power) "^"] >= 0)} {
				puts $g "\n$power"
			}
		}
		
		puts -nonewline $g $endBuffer
		puts -nonewline $g $backBuffer
				
		close $g
	}
}

# Check arguments.

if {[llength $argv]} {
	set helpInfo {
		"Usage: advance.tcl [-?] [--] game.txt"
		"\t-?: Display this help message"
		"\t--: No more switches to follow"	
	}
	
	while {[llength $argv] && [regexp "^\[-/\](.)$" [lindex $argv 0] switching swi]} {
		set argv [lrange $argv 1 end]
		switch -- $swi ? {
			puts [join $helpInfo "\n"]
			exit
		} - {
			break
		} default {
			Advance::mention "Switch <$swi> not supported." {} $helpInfo
			exit
		}
	}
	
	set arguments $argv
	set argv {}
	switch [llength $arguments] 1 {
	} default {
		Advance::mention [join {
			"1 argument required, the name of a DPeye style game record .txt file."
			"Usage: advance.tcl game.txt"
		} "\n"] {} $helpInfo
		exit
	}

	eval Advance::advance $arguments
}
